#!perl

use strict;
use warnings;
use encoding 'UTF-8';
use Parse;
use Data::Dump qw(dump);

package JsDoc;

my $debug = 0;

sub new {
    my $self = {
        prototype => [],
        function => [],
        object => [],
        class => [],
        method => [],
        methodgroup => [],
        var => [],
        doc_dir => '.',
        menu_html => {}
    };
    my ($class) = (shift);
    my %param = @_;
    if (exists $param{file}) {
        open FH, '<encoding(utf-8)', $param{file} or die "open file $param{file} failed:$!";
        my @jscode = <FH>;
        close FH;
        $self->{parser} = Parse::->new('javascript', join('', @jscode));
    } elsif (exists $param{content}) {
        $self->{parser} = Parse::->new('javascript', $param{content});
    }
    if (exists $param{doc_dir}) {
        $self->{doc_dir} = $param{doc_dir};
    }
    $self->{doc_parser} = Parse::->new('javascript');
    bless $self, $class;
    
    $self->run if $self->{parser};
    return $self;
}

sub get_next_id {
    my $self = shift;
    if ($self->{index} + 1 < $self->{length}) {
        return $self->{parser}->{id_vector}->[++$self->{index}];
    }
    0;
}

sub next_id {
    my $self = shift;
    if ($self->{index} + 1 < $self->{length}) {
        return $self->{parser}->{id_vector}->[$self->{index}];
    }
    0;
}

sub get_current_id {
    my $self = shift;
    if ($self->{index} < $self->{length}) {
        return $self->{parser}->{id_vector}->[$self->{index}];
    }
    0;
}

sub get_str {
    my $ids = shift;
    my $ret = '';
    for my $id (@{$ids}) {
        $ret .= $id->{value};
    }
    return $ret;
}

my %separ_expect_end = ('(' => ')', '{' => '}', '[' => ']');

#获取一个封闭的代码块
#{...}, (...), [...]
sub get_close_scope {
    my ($self, $start) = @_;
    my $end = $separ_expect_end{$start};
    return 0 unless $end;
    my $idCnt = [];
    my $deep = 1;
    while (my $id = $self->get_next_id) {
        $deep ++ if $id->{value} eq $start;
        $deep -- if $id->{value} eq $end;
        last if $deep == 0;
        push @{$idCnt}, $id;
    }
    return get_str $idCnt;
}

#获取至一个特定位置为止的代码内容
sub get_content_end_of {
    my $self = shift;
    my %cond = @_;
    my @idCnt = ();
    while (my $id = $self->get_next_id) {
        last if exists $cond{type} && $cond{type} == $id->{type};
        last if exists $cond{types} && $cond{types}->{$id->{type}};
        last if exists $cond{value} && $cond{value} eq $id->{value};
        last if exists $cond{values} && $cond{values}->{$id->{value}};
        push @idCnt, $id;
    }
    return get_str \@idCnt;
}

#获取一个到特定位置的ID
sub get_id_until {
    my $self = shift;
    my %cond = @_;
    my $id;
    while (1) {
        $id = $self->get_next_id;
        last unless $id;
        last if exists $cond{type} && $cond{type} == $id->{type};
        last if exists $cond{types} && $cond{types}->{$id->{type}};
        last if exists $cond{value} && $cond{value} eq $id->{value};
        last if exists $cond{values} && $cond{values}->{$id->{value}};
    }
    return $id;
}

#获取一个函数
sub get_function {
    my ($self, $remark) = @_;
    my $id = $self->get_next_id;
    return 0 unless $id;
    my $function = {};
    $id = $self->get_next_id if $id->{type} == IdItem::BLANK;

    if ($id->{value} eq 'var') {
        #var funname = function(arg1,arg2){};
        my $function_name = $self->get_id_until (type=>IdItem::ID, value=>'$');
        $function->{name} = $function_name->{value}; 
    } elsif ($id->{value} eq 'function') {
        #function funname(arg1, arg2) {}
        my $function_name = $self->get_id_until (type=>IdItem::ID, value=>'$');
        $function->{name} = $function_name->{value};    
    } else {
        #funname: function(arg1,arg2){}
        #a.funname = function (arg1, arg2) {}
        $self->{index}--;
        $function->{name} = $self->get_content_end_of(type=>IdItem::BLANK, values=>{':'=>1, '='=>1});
    }

    $self->get_id_until(value=>'(');
    $function->{arguments} = $self->get_close_scope('(');
    $self->get_id_until(value=>'{');
    $function->{body} = $self->get_close_scope('{');
    set_common_info($function, $remark);

    return $function;
}

#获取一个变量
#var varname = value;
#a.b = value;
#pro : value,
sub get_variable {
    my ($self, $remark) = @_;
    my $id = $self->get_next_id;
    return 0 unless $id;
    $id = $self->get_next_id if $id->{type} == IdItem::BLANK;
    return 0 unless $id;
    my $variable = {};
    if ($id->{value} eq 'var') {
        my $varname = $self->get_id_until(type=>IdItem::ID);
        return 0 unless $varname;
        $variable->{name} = $varname->{value};
        $self->get_id_until(value=>'=');
        $variable->{value} = $self->get_content_end_of(value=>';');
    } else {
        $self->{index}--;
        $variable->{name} = $self->get_content_end_of(type=>IdItem::BLANK, values=>{':'=>1, '='=>1});
        $self->get_next_id if $self->get_current_id->{type} == IdItem::BLANK;
        if ($self->get_current_id->{value} eq '=') {
            $variable->{value} = $self->get_content_end_of(value=>';')
        } else {
            my $value = '';
            while (1) {
                my $foo = $self->get_content_end_of(values=>{'('=>1, '{'=>1, '['=>1, ','=>1, '}'=>1});
                my $cur_value = $self->get_current_id->{value};
                if ($cur_value eq ',') {
                    $value .= $foo;
                    last;
                }
                if ($separ_expect_end{$cur_value}) {
                    $value .= $foo . $cur_value;
                    $value .= $self->get_close_scope($cur_value) . $separ_expect_end{$cur_value};
                }
                if ($cur_value eq '}') {
                    $value .= $foo;
                    $self->{index}--;
                    last;
                }
            }
            $value =~ s/\s+$//;
            $variable->{value} = $value;
        }
    }
    if ($self->next_id && $self->next_id->{type} == IdItem::BLANK) {
        $self->get_next_id;
    }

    set_common_info($variable, $remark);
    return $variable;
}


sub set_common_info {
    my ($o, $remark) = @_;
    my $foo = get_namespace_and_realname($o->{name}, $remark);
    $o->{name} = $foo->{name};
    $o->{namespace} = $foo->{namespace};
    $o->{description} = get_description($remark);
    $o->{example} = get_example($remark);
}

sub get_example {
    my $remark = shift;
    my ($example) = $remark =~ m'@example(.+?)(?=\n\s+\*\s@|\*/)'si;
    $example =~ s/^\s*:|^\s+\*\s?//mg if $example;
    if ($example) {
        my ($html) = $example =~ m#<html>(.+)</html>#si;
        $example =~ s#<html>(.+)</html>##si;
        $example =~ s#(^\s*\n|\s+$)##sg;
        return {html=>$html, jscode=>$example};
    }
    0;
}

sub get_description {
    my $remark = shift;
    my ($description) = $remark =~ m'@description(.+?)(?=\n\s+\*\s@|\*/)'si;
    $description =~ s/^\s*:|^\s+\*//mg if $description;
    return $description;
}

sub get_namespace_and_realname {
    my ($name, $remark) = @_;
    my $ret = {};
    my @takens = split /\./, $name;
    $ret->{name} = pop @takens;
    if (scalar @takens) {
        $ret->{namespace} = join '.', @takens;
    } else {
        if ($remark and my ($namespace) = ($remark =~ m'@namespace\s+(.+)$'mi)) {
            $ret->{namespace} = $namespace;                        
        } else {
            $ret->{namespace} = 'window';
        }
    }
    return $ret;
}

sub get_content {
    my ($self, $remark, $type) = @_;
    $remark = $remark->{value};
    CASE : {
        $type eq 'function' and do {
            my $function = $self->get_function($remark);
            push @{$self->{'function'}}, $function;
            print 'get function:', Data::Dump::dump($function), "\n" if $debug;
            last CASE;
        };
        
        $type eq 'prototype' and do {
            my $function = $self->get_function($remark);
            $function->{is_prototype} = 1;
            push @{$self->{'prototype'}}, $function;            
            print 'get prototype:', Data::Dump::dump($function), "\n" if $debug;
            last CASE;
        };

        $type eq 'method' and do {
            my $function = $self->get_function($remark);
            $function->{is_prototype} = 1;
            push @{$self->{'method'}}, $function;            
            print 'get method:', Data::Dump::dump($function), "\n" if $debug;
            last CASE;
        };
        
        $type eq 'methods' and do {
            my $methods = {};
            my ($name) = $remark =~ m'@name\s+(.+)$'m;
            last CASE unless $name;
            $methods->{name} = $name;
            $methods->{is_prototype} = 1;
            set_common_info $methods, $remark;
            push @{$self->{'methodgroup'}}, $methods;
            last CASE;
        };

        $type eq 'var' and do {
            my $variable = $self->get_variable($remark);
            push @{$self->{'var'}}, $variable;
            print 'get variable:', Data::Dump::dump($variable), "\n" if $debug;
            last CASE;
        };

        $type eq 'class' and do {
            my $class = {};
            my ($classname) = $remark =~ m'@class\s+([a-zA-Z0-9.$_]+)';
            $class->{name} = $classname;
            set_common_info $class, $remark;
            push @{$self->{'class'}}, $class;

            print 'get class:', Data::Dump::dump($class), "\n" if $debug;
            last CASE;
        };

        $type eq 'Object' and do {
            my $object = {};
            my ($objectname) = $remark =~ m'@Object\s+([a-zA-Z0-9.$_]+)';
            $object->{name} = $objectname;
            set_common_info $object, $remark;
            push @{$self->{'object'}}, $object;

            print 'get object:', Data::Dump::dump($object), "\n" if $debug;
            last CASE;
        };
    }
}

sub run {
    my $self = shift;
    
    $self->{index} = -1;
    $self->{length} = scalar @{$self->{parser}->{id_vector}};

    while (1) {
        my $id = $self->get_next_id;
        last unless $id;
        if ($id->{type} == IdItem::REMARK) {
            if (my ($doc_type) = $id->{value} =~ m#^/\*\*\s+\*\s*@(\w+)#) {
                $self->get_content($id, $doc_type);
            }
        }
    }

    $self->to_doc;
}

sub print_functions {
    my ($self, $fh, $namespace, $funs, $show_full_name) = @_;
    my $function_names = [];
    return unless $funs;
    print $fh '<dl class="item">';
    for my $fun (sort {
            my $aa = $a->{namespace};
            if ($aa eq 'window') {
                $aa = $a->{name};
            } else {
                $aa .= '.' . $a->{name};
            }
            my $bb = $b->{namespace};
            if ($bb eq 'window') {
                $bb = $b->{name};
            } else {
                $bb .= '.' . $b->{name};
            }
            scalar(my @a = split(/\./, $aa)) <=> scalar(my @b = split(/\./, $bb)) or lc($a->{name}) cmp lc($b->{name})
        } @{$funs}) {
        my $na = $namespace || $fun->{namespace} || 'window';
        my $isGroup = not exists $fun->{arguments};
        push @{$function_names}, [($show_full_name and $na ne 'window') ? $na . '.' . $fun->{name} : $fun->{name}, $na . '.' . $fun->{name}];
        print $fh '<dt><b class="function_head"><a name="', $na, '.', $fun->{name},'" href="#', $na, '.', $fun->{name},'">',  (($show_full_name and $na ne 'window') ? $na . '.' . $fun->{name} : $fun->{name}), '</a></b>&nbsp;';
        print $fh '<a href="javascript:void(0)" onclick="view_source(this)">hide source</a>' unless $isGroup;
        print $fh '</dt>';
        unless ($isGroup) {
            print $fh '<dd class="code" style="display:block">';
            $self->{doc_parser}->run(
                $na . '.' . ($fun->{is_prototype} ? 'prototype.' : '') . $fun->{name} . ' = function(' . $fun->{arguments} . ") {" .
                $fun->{body} .
                "};"
            );
            print $fh $self->{doc_parser}->to_html();
            print $fh '</dd>';
        }
        print $fh '<dd>';
        $self->print_common_info($fh, $fun);
        print $fh '</dd>';
    }
    print $fh '</dl>';
    return $function_names;
}

sub print_variables {
    my ($self, $fh, $namespace, $vars, $show_full_name) = @_;
    my $var_names = [];
    return unless $vars;
    print $fh '<dl class="item">';
    for my $var (sort {
            my $aa = $a->{namespace};
            if ($aa eq 'window') {
                $aa = $a->{name};
            } else {
                $aa .= '.' . $a->{name};
            }
            my $bb = $b->{namespace};
            if ($bb eq 'window') {
                $bb = $b->{name};
            } else {
                $bb .= '.' . $b->{name};
            }
            scalar(my @a = split(/\./, $aa)) <=> scalar(my @b = split(/\./, $bb)) or lc($a->{name}) cmp lc($b->{name})
        } @{$vars}) {
        my $na = $namespace || $var->{namespace} || 'window';
        push @{$var_names}, [($show_full_name and $na ne 'window') ? $na . '.' . $var->{name} : $var->{name}, $na . '.' . $var->{name}];
        print $fh '<dt><b class="variable_head"><a href="#', $na, '.', $var->{name},'" name="', $na, '.', $var->{name},'">',  (($show_full_name and $na ne 'window') ? $na . '.' . $var->{name} : $var->{name}), '</a></b>&nbsp;';
        print $fh '<a href="javascript:void(0)" onclick="view_source(this)">hide source</a>';
        print $fh '</dt>';

        print $fh '<dd class="code" style="display:block">';
        $self->{doc_parser}->run($na . '.' . $var->{name} . ' = ' . $var->{value} . ';');
        print $fh $self->{doc_parser}->to_html();
        print $fh '</dd>';

        print $fh '<dd>';
        $self->print_common_info($fh, $var);
        print $fh '</dd>';
    }
    print $fh '</dl>';
    return $var_names;
}

sub print_common_info {
    my ($self, $fh, $o) = @_;
    if ($o->{description}) {
        print $fh '<h3>Description:</h3>';
        print $fh '<p class="description">', to_html_str($o->{description}), '</p>';
    }
    if ($o->{example}) {
        print $fh '<h3>Example:</h3>';
        print $fh '<fieldset class="example_html"><legend>Html</legend>', to_html_str($o->{example}->{html}), '</fieldset>' if $o->{example}->{html};
        $self->{doc_parser}->run($o->{example}->{jscode});
        print $fh '<fieldset class="example_code"><legend>Code</legend>', $self->{doc_parser}->to_html(), '</fieldset>';
    }
}

sub to_html_str {
    $_ = shift;
    s#(<[^<>]+>)#_TS_$1_TE_#g;
    s#<#&lt;#g;
    s#>#&gt;#g;
    s#_TS_#<b>#g;
    s#_TE_#</b>#g;
    s#\n#<br/>#g;
    s{\@see\(\s*(.+?),\s*(.+?),\s*(.+?)\)}{
        "<a href='$1.html#$2'>$3</a>"
    }ge;
    $_;
}

sub to_nature_doc {
    my $self = shift;
    my $o = {};
    my $pro_page_fn = $self->{doc_dir} . '/' . 'prototype.html';
    open PRO_OUT, '>:encoding(utf-8)', $pro_page_fn or die "open file $pro_page_fn failed:$!";
    print_page_head(*PRO_OUT);
    for my $prototype (@{$self->{prototype}}) {
        my @namespace = split /\./, $prototype->{namespace};
        $o->{$namespace[0]} = [] unless exists $o->{$namespace[0]};
        push @{$o->{$namespace[0]}}, $prototype;
    }
    my $menu_html = '<dl><dt><a href="prototype.html">Nature</a><dt>';
    my $pop_html = '';
    for my $na (sort keys %{$o}) {
        $pop_html .= "<dl><dt><a href='#$na'>$na</a></dt>";
        $menu_html .= '<dd><a href="prototype.html#' . $na . '">' . $na . '</a></dd>'; 
        print PRO_OUT '<h2><a name="', $na, '" href="#', $na, '">', $na, '</a></h2>';
        my $names = $self->print_functions(*PRO_OUT, $na, $o->{$na});
        for my $name(@{$names}) {
            $pop_html .= "<dd><a href='#$name->[1]'>$name->[0]</a></dd>";
        }
        $pop_html .= "</dl>";
    }
    $menu_html .= '</dl>';
    $self->{menu_html}->{nature} = $menu_html;
    print PRO_OUT '<div id="name_index"><h3><a name="#name_index">名称索引</a>', $pop_html, '</h3></div>';
    print PRO_OUT '<div id="pop_up"><a href="#name_index">查看名称索引</a></div>';
    print_page_end(*PRO_OUT);
    close PRO_OUT;
}

sub to_class_doc {
    my $self = shift;
    my $o = {};
    for my $class (@{$self->{class}}) {
        print $class->{name}, "\n" if $debug;
        my $className = $class->{name};
        $className = $class->{namespace} . '.' . $className if ($class->{namespace} && $class->{namespace} ne 'window');
        $o->{$className} = $class;
    }
    for my $method (@{$self->{method}}) {
        my $namespace = $method->{namespace};
        next unless $namespace;
        $o->{$namespace} = {name=>$namespace} unless $o->{$namespace};
        $o->{$namespace}->{methods} = [] unless $o->{$namespace}->{methods};
        push @{$o->{$namespace}->{methods}}, $method;
        print "namespace:$namespace\n$method->{name}" if $debug;
    }

    for my $methods (@{$self->{methodgroup}}) {
        my $namespace = $methods->{namespace};
        next unless $namespace;
        $o->{$namespace} = {name=>$namespace} unless $o->{$namespace};
        $o->{$namespace}->{methods} = [] unless $o->{$namespace}->{methods};
        push @{$o->{$namespace}->{methods}}, $methods;
        print "namespace:$namespace\t$methods->{name}\n" if $debug;
    }

    my $fn = $self->{doc_dir} . '/class.html';
    open CLASS_OUT, '>:encoding(utf-8)', $fn or die "open file $fn failed:$!";
    print_page_head(*CLASS_OUT);

    my $menu_html = '<dl><dt><a href="class.html">Class</a></dt>';
    my $pop_html = '';
    for my $className (sort {scalar(my @a = split(/\./, $a)) <=> scalar(my @b = split(/\./, $b)) or $a cmp $b} keys %{$o}) {
        $menu_html .= '<dd><a href="class.html#' . $className . '">' . $className . '</a></dd>';
        $pop_html .= "<dl><dt><a href='#$className'>$className</a></dt>";
        print CLASS_OUT '<h2><a name="', $className, '" href="#', $className, '">', $className, '</a></h2>';
        print CLASS_OUT '<dl>';
        print CLASS_OUT '<dd>';
        $self->print_common_info(*CLASS_OUT, $o->{$className});
        print CLASS_OUT '</dd>';
        my $names = $self->print_functions(*CLASS_OUT, $className, $o->{$className}->{methods});
        print CLASS_OUT '</dl>';
        for my $name(@{$names}) {
            $pop_html .= "<dd><a href='#$name->[1]'>$name->[0]</a></dd>";
        }
        $pop_html .= "</dl>";
    }
    $menu_html .= '</dl>';
    $self->{menu_html}->{class} = $menu_html;
    print CLASS_OUT '<div id="name_index"><h3><a name="#name_index">名称索引</a>', $pop_html, '</h3></div>';
    print CLASS_OUT '<div id="pop_up"><a href="#name_index">查看名称索引</a></div>';
    print_page_end(*CLASS_OUT);
    close CLASS_OUT;
}

sub to_object_doc {
    my ($self) = @_;
    my $o = {};
    my $new_var = [];
    my $new_function = [];
    for my $object (@{$self->{object}}) {
        my $ns = $object->{namespace} . '.' . $object->{name};
        print "$ns\n" if $debug;
        $o->{$ns} = $object;
    }
    for my $function (@{$self->{function}}) {
        my $ns = $function->{namespace};
        push(@{$new_function}, $function) and next unless $ns and $ns ne 'window' and exists $o->{$ns};
        $o->{$ns}->{methods} = [] unless $o->{$ns}->{methods};
        push @{$o->{$ns}->{methods}}, $function;
        print "$function->{namespace}\t$function->{name}\n" if $debug;
    }
    
    for my $variable (@{$self->{var}}) {
        my $ns = $variable->{namespace};
        push(@{$new_var}, $variable) and next unless $ns and $ns ne 'window' and exists $o->{$ns};
        $o->{$ns}->{variables} = [] unless $o->{$ns}->{variables};
        push @{$o->{$ns}->{variables}}, $variable;
        print "$variable->{namespace}\t$variable->{name}\n" if $debug;
        print $variable->{value}, "\n" if $debug;
    }
    
    $self->{var} = $new_var;
    $self->{function} = $new_function;

    my $fn = $self->{doc_dir} . '/object.html';
    open OBJECT_OUT, '>:encoding(utf-8)', $fn or die "open file $fn failed:$!";
    print_page_head(*OBJECT_OUT);

    my $menu_html = '<dl><dt><a href="object.html">Object</a></dt>';
    my $pop_html = '';
    for my $objectName (sort {scalar(my @a = split(/\./, $a)) <=> scalar(my @b = split(/\./, $b)) or $a cmp $b} keys %{$o}) {
        $menu_html .= '<dd><a href="object.html#' . $objectName . '">' . $objectName . '</a></dd>';
        $pop_html .= "<dl><dt><a href='#$objectName'>$objectName</a></dt>";
        print OBJECT_OUT '<h2><a name="', $objectName, '" href="#', $objectName, '">', $objectName, '</a></h2>';
        print OBJECT_OUT '<dl>';
        print OBJECT_OUT '<dd>';
        $self->print_common_info(*OBJECT_OUT, $o->{$objectName});
        print OBJECT_OUT '</dd>';
        my $var_names = $self->print_variables(*OBJECT_OUT, $objectName, $o->{$objectName}->{variables});
        my $fun_names  = $self->print_functions(*OBJECT_OUT, $objectName, $o->{$objectName}->{methods});
        for my $var_name (@{$var_names}) {
            $pop_html .= "<dd><a href='#$var_name->[1]'>$var_name->[0]</a></dd>";
        }
        for my $fun_name (@{$fun_names}) {
            $pop_html .= "<dd><a href='#$fun_name->[1]'>$fun_name->[0]</a></dd>";
        }
        $pop_html .= '</dl>';
        print OBJECT_OUT '</dl>';
    }
    $menu_html .= '</dl>';
    $self->{menu_html}->{object} = $menu_html;
    print OBJECT_OUT '<div id="name_index"><h3><a name="#name_index">名称索引</a>', $pop_html, '</h3></div>';
    print OBJECT_OUT '<div id="pop_up"><a href="#name_index">查看名称索引</a></div>';
    print_page_end(*OBJECT_OUT);
    close OBJECT_OUT;
}

sub to_base_doc {
    my $self = shift;
    my $fn = $self->{doc_dir} . "/base.html";
    open BASE_OUT, '>:encoding(utf-8)', $fn or die "open file $fn failed:$!";
    print_page_head(*BASE_OUT);
    my $menu_html = '<dl><dt>Base</dt><dd><a href="base.html">base</a></dd></dl>';
    my $pop_html = '<dl>';
    my $var_names = $self->print_variables(*BASE_OUT, undef, $self->{var}, 1);
    my $fun_names = $self->print_functions(*BASE_OUT, undef, $self->{function}, 1);
     for my $var_name (@{$var_names}) {
        $pop_html .= "<dd><a href='#$var_name->[1]'>$var_name->[0]</a></dd>";
    }
    for my $fun_name (@{$fun_names}) {
        $pop_html .= "<dd><a href='#$fun_name->[1]'>$fun_name->[0]</a></dd>";
    }
    $pop_html .= '</dl>';
    $self->{menu_html}->{base} = $menu_html;
    print BASE_OUT '<div id="name_index"><h3><a name="#name_index">名称索引</a>', $pop_html, '</h3></div>';
    print BASE_OUT '<div id="pop_up"><a href="#name_index">查看名称索引</a></div>';
    print_page_end(*BASE_OUT);
    close BASE_OUT;
}

sub to_doc {
    my $self = shift;

    $self->to_nature_doc;
    $self->to_class_doc;
    $self->to_object_doc;
    $self->to_base_doc;

    my $fn = $self->{doc_dir} . "/menu.html";
    open MENU_OUT, '>:encoding(utf-8)', $fn or die "open file $fn failed:$!";
    print_page_head(*MENU_OUT, '<base target="content"/>');
    print MENU_OUT '<a href="source.html">view source</a>';
    print MENU_OUT $self->{menu_html}->{nature};
    print MENU_OUT $self->{menu_html}->{base};
    print MENU_OUT $self->{menu_html}->{object};
    print MENU_OUT $self->{menu_html}->{class};
    print_page_end(*MENU_OUT);
    close MENU_OUT;
    $self->create_index_page;

    my $source_fn = $self->{doc_dir} . "/source.html";
    open SOURCE_OUT, ">:encoding(utf-8)", $source_fn or die "open file $source_fn failed:$!";
    print_page_head(*SOURCE_OUT);
    print SOURCE_OUT $self->{parser}->to_html;
    print_page_end(*SOURCE_OUT);
    close SOURCE_OUT;
}

sub create_index_page {
    my $self = shift;
    my $fn = $self->{doc_dir} . '/index.html';
    open OUT, '>:encoding(utf-8)', $fn or die "open file $fn failed:$!";
    print OUT <<HTML;
<html>
<head>
<meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
<title>dollar.js document</title>
</head>
<frameset cols="200, *">
<frame src="menu.html"></frame>
<frame name="content" src="base.html"></frame>
</frameset>
<html>
HTML
    close OUT;
}

sub print_page_head {
    my $fh = shift;
    my $extern_head = shift;
    print $fh <<HTML_START;
<html>
<head>
<meta http-equiv="Content-Type" content="text/html;charset=utf-8"/>
<title>JSCODE</title>
HTML_START
print $fh $extern_head if $extern_head;
print $fh <<HTML_START;
<style>
html{
width:100%;
height:100%;
margin:0;
padding:0;
overflow:hidden;
}
body {
margin:0;
padding:0;
width:100%;
height:100%;
overflow:hidden;
font-size:12px;
font-family:"Andale Mono";
}
#main{
padding:10px 0 0 10px;
height:100%;
overflow:auto;
}
#pop_up{
position:absolute;
right:16px;
top:0;
padding:10px;
background:#fff;
overflow:auto;
border:1px solid #000;
}
dd{
margin-left:20px;
}
h2 a{
color:#006A00;
text-decoration:none;
}
h2 a:hover{
text-decoration:underline;
}
h3{
    color:#aaa;
}
.function_head{
    
}
.variable_head{

}
.example_html b{
    color:#0080C0;
}
p.description {
    border-left:3px solid #aaa;
    border-bottom:1px solid #aaa;
    padding-left:10px;
}
.code{
    border:1px solid #ccc;
    margin-top:5px;
    font-size:11px;
    background:#dedede;
    overflow:auto;
}
dl.item {
    margin-bottom:20px;
}
dl.item dt{
    margin-top:50px;
    background:#eee;
    margin-left:10px;
}
dl.item dt a{
    color:#FF7700;
}
dl.item dt b a{
    font-size:13px;
    color:#333;
    text-decoration:none;
}
dl.item dt b a:hover{
    font-size:13px;
    color:#333;
    text-decoration:underline;
}
li{border-bottom:1px dashed #ccc;line-height:25px}
li b{font-weight:normal}
#name_index{
    border-top:3px solid #ccc;
}
HTML_START
    for my $keytype (keys %{$IdItem::Colors}) {
        print $fh '.c' . $keytype . '{color:' . $IdItem::Colors->{$keytype} . '}';
    }
    print $fh <<HTML_START;
</style>
<script>
function view_source (a) {
    var c = a.parentNode.nextSibling;
    if (c.style.display == 'none') {
        c.style.display = 'block';
    } else {
        c.style.display = 'none';
    }
    return false;
}
</script>
</head>
<body>
<div id="main">
HTML_START
}

sub print_page_end {
    my $fh = shift;
    print $fh <<HTML_END;
</div>
</body>
</html>
HTML_END
}
1;
